Executive summary

Dane wykorzystane w niniejszej analizie zostały zebrane przez różne instytucje, głównie przez Bank Światowy. Zawierają one między innymi informacje na temat wskaźników gospodarczych państw w poszczególnych latach (1920-2020). Dodatkowo, w analizie zostały wykorzystane dane na temat obrotu bitcoinem, cen złota oraz miesięcznych wynikach S&P Composite. Dane zostały poddane czyszczeniu oraz licznym tranformacjom umożliwiającym analizę.

Analiza zbiorów danych obejmowała sprawdzenie najbardziej interesujących korelacji między poszczególnymi wskaźnikami gospodarczymi oraz próbę ich interpretacji. Została również sprawdzona korelacja między ceną bitcoina a kolumnami w zbiorze dotyczącym bitcoina, cen złota oraz S&P Composite w celu stworzenia regresora. Ponadto, przeanalizowana została populacja Chin, Indii oraz USA.

Model regresji przewidujący cenę bitcoina został stworzony z wykorzystaniem algorytmu lasso oraz ridge.

Wykorzystane biblioteki

  • readxl
  • dplyr
  • tidyr
  • tibble
  • DT
  • ggplot2
  • gganimate
  • gifski
  • caret
  • knitr
  • ggcorrplot
  • plotly
  • gridExtra
  • kableExtra
library("readxl")
library("dplyr")
library("tidyr")
library("tibble")
library("DT")
library("ggplot2")
library("gganimate")
library("gifski")
library("caret")
library("knitr")
library("ggcorrplot")
library("plotly")
library("gridExtra")
library("kableExtra")

Wczytanie danych

Dane zostały wczytane z wykorzystaniem standardowej funkcji read.csv oraz read_excel pochodzącej z biblioteki readxl.

wdi <- read_excel("./data/World_Development_Indicators.xlsx")
sp_composite <- read.csv("./data/S&P Composite.csv")
gold_prices <- read.csv("./data/Gold Prices.csv")
bitcoin_diff <- read.csv("./data/Bitcoin/BCHAIN-DIFF.csv")
bitcoin_hrate <- read.csv("./data/Bitcoin/BCHAIN-HRATE.csv")
bitcoin_mkpru <- read.csv("./data/Bitcoin/BCHAIN-MKPRU.csv")
bitcoin_trvou <- read.csv("./data/Bitcoin/BCHAIN-TRVOU.csv")

Czyszczenie danych

Zbiór wdi (World Development Indicators)

Kolumna Series Name została przeniesiona ze zbioru wdi do zbioru wdi_names, ponieważ została uznana za zbędną i utrudniającą dalszą pracę na zbiorze danych - była opisem danego wskaźnika gospodarczego, którego identyfikator znajdował się w kolumnie Series Code. Usunięta została również kolumna Country Code, ponieważ nie została wykorzystana w dalszej analizie.

Czyszczenie zbioru wdi obejmowało:

  1. Usunięcie wierszy zawierających wszystkie wartości puste.
  2. Skondensowanie kolumn z latami do jednej kolumny Year.
  3. Usunięcie duplikatów wierszy.
  4. Rozszerzenie kolumny Series Code do postaci wielu kolumn.
  5. Wybranie tylko tych kolumn ze wskaźnikami, które posiadają przynajmniej 50% uzupełnionych wartości.
  6. Zmiany formatu daty kolumny Year z yyyy [YRyyyy] na yyyy.
  7. Przekonwertowanie kolumn ze wskaźnikami na typ numeryczny. Podczas takiej konwersji wartości puste w postaci .. zostały zamienione na NA.
wdi_names <- wdi %>%
  select("Series Code", "Series Name") %>%
  distinct()

wdi_reshaped <- wdi %>%
  select(-c("Series Name", "Country Code")) %>%
  filter(!if_all(3:53, ~ . == ".."), na.rm = TRUE) %>%
  gather("Year", "Value", 3:53) %>%
  distinct() %>%
  spread("Series Code", "Value") %>%
  select(which(colMeans(!is.na(.) & . != "..") > 0.5)) %>%
  mutate(Year = substr(Year, 0, 4)) %>%
  mutate_at(3:115, function(x) as.numeric(x))


Podsumowanie zbioru wdi_reshaped

kable(summary(wdi_reshaped)) %>%
  kable_styling("striped") %>%
  scroll_box(width = "100%")
Country Name Year AG.LND.TOTL.K2 BG.GSR.NFSV.GD.ZS BM.GSR.FCTY.CD BM.GSR.MRCH.CD BM.GSR.NFSV.CD BN.GSR.FCTY.CD BN.KLT.PTXL.CD BX.GSR.FCTY.CD BX.GSR.MRCH.CD BX.GSR.NFSV.CD BX.PEF.TOTL.CD.WD DT.ODA.ODAT.CD EG.ELC.ACCS.ZS EG.ELC.COAL.ZS EG.ELC.FOSL.ZS EG.ELC.HYRO.ZS EG.ELC.NGAS.ZS EG.ELC.NUCL.ZS EG.ELC.RNEW.ZS EG.ELC.RNWX.KH EG.ELC.RNWX.ZS EG.FEC.RNEW.ZS EN.ATM.CO2E.EG.ZS EN.ATM.CO2E.GF.KT EN.ATM.CO2E.GF.ZS EN.ATM.CO2E.KD.GD EN.ATM.CO2E.KT EN.ATM.CO2E.LF.KT EN.ATM.CO2E.LF.ZS EN.ATM.CO2E.PC EN.ATM.CO2E.SF.KT EN.ATM.CO2E.SF.ZS EN.ATM.GHGT.KT.CE EN.ATM.METH.EG.KT.CE EN.ATM.METH.KT.CE EN.ATM.NOXE.EG.ZS EN.ATM.NOXE.KT.CE EN.CO2.BLDG.ZS EN.CO2.ETOT.ZS EN.CO2.MANF.ZS EN.CO2.OTHX.ZS EN.CO2.TRAN.ZS EN.POP.DNST EN.URB.LCTY EN.URB.LCTY.UR.ZS EN.URB.MCTY FM.AST.DOMS.CN FP.CPI.TOTL FP.CPI.TOTL.ZG IT.NET.USER.ZS NE.DAB.TOTL.CD NE.DAB.TOTL.ZS NE.EXP.GNFS.CD NE.EXP.GNFS.KD.ZG NE.IMP.GNFS.CD NE.IMP.GNFS.ZS NE.TRD.GNFS.ZS NV.IND.MANF.ZS NV.SRV.TOTL.ZS NY.GDP.MKTP.CD NY.GDP.MKTP.KD.ZG NY.GDP.NGAS.RT.ZS NY.GDP.PCAP.CD NY.GDP.PCAP.KD.ZG NY.GDP.TOTL.RT.ZS NY.GDS.TOTL.CD NY.GDS.TOTL.ZS NY.GNS.ICTR.CD NY.GNS.ICTR.ZS NY.GSR.NFCY.CD NY.GSR.NFCY.CN NY.TAX.NIND.CD NY.TAX.NIND.CN NY.TAX.NIND.KN SE.PRM.AGES SE.PRM.ENRL.TC.ZS SE.SEC.ENRL SH.DTH.MORT SL.AGR.EMPL.ZS SL.EMP.MPYR.ZS SL.EMP.SELF.FE.ZS SL.EMP.SELF.MA.ZS SL.EMP.SELF.ZS SL.IND.EMPL.ZS SL.SRV.EMPL.ZS SL.TLF.TOTL.IN SP.DYN.CBRT.IN SP.DYN.IMRT.IN SP.DYN.LE00.IN SP.DYN.TO65.FE.ZS SP.DYN.TO65.MA.ZS SP.POP.0014.TO.ZS SP.POP.1564.TO.ZS SP.POP.65UP.TO.ZS SP.POP.GROW SP.POP.TOTL SP.POP.TOTL.FE.IN SP.POP.TOTL.FE.ZS SP.POP.TOTL.MA.IN SP.POP.TOTL.MA.ZS SP.RUR.TOTL SP.RUR.TOTL.ZG SP.RUR.TOTL.ZS SP.URB.GROW SP.URB.TOTL SP.URB.TOTL.IN.ZS TM.VAL.FOOD.ZS.UN TM.VAL.FUEL.ZS.UN TM.VAL.TRAN.ZS.WT TX.VAL.FOOD.ZS.UN TX.VAL.FUEL.ZS.UN TX.VAL.MRCH.HI.ZS TX.VAL.TRAN.ZS.WT
Length:10608 Length:10608 Min. : 2 Min. : 1.165 Min. :-2.187e+08 Min. :5.153e+06 Min. :9.128e+05 Min. :-1.052e+11 Min. :-8.080e+11 Min. :-5.061e+07 Min. :1.991e+05 Min. :0.000e+00 Min. :-2.441e+11 Min. :-9.899e+08 Min. : 0.534 Min. : 0.00 Min. : 0.00 Min. : 0.00 Min. : 0.000 Min. : 0.000 Min. : 0.000 Min. :0.000e+00 Min. : 0.000 Min. : 0.000 Min. : 0.054 Min. : -147 Min. : -0.7295 Min. :0.0000 Min. : 0 Min. : -161 Min. : -6.089 Min. : 0.000 Min. : -114 Min. : -4.324 Min. : 1 Min. : 0 Min. : 0 Min. : 0.000 Min. : 0.0 Min. : 0.000 Min. : 0.00 Min. : 0.00 Min. :-2.326 Min. : 0.00 Min. : 0.136 Min. : 18587 Min. : 2.867 Min. : 34329 Min. :-5.424e+13 Min. : 0.00 Min. : -18.109 Min. : 0.00 Min. :1.805e+07 Min. : 21.21 Min. :6.933e+05 Min. : -96.4 Min. :0.000e+00 Min. : 0.00 Min. : 0.021 Min. : 0.000 Min. :10.86 Min. :8.824e+06 Min. :-64.047 Min. : 0.0000 Min. : 22.8 Min. :-64.9924 Min. : 0.000 Min. :-7.622e+09 Min. :-141.97 Min. :-2.601e+10 Min. :-236.27 Min. :-9.905e+10 Min. :-4.813e+14 Min. :-1.444e+10 Min. :-1.255e+14 Min. :-9.832e+13 Min. :4.000 Min. : 5.226 Min. : 0 Min. : 0 Min. : 0.030 Min. : 0.000 Min. : 0.07 Min. : 0.39 Min. : 0.41 Min. : 0.28 Min. : 5.34 Min. :3.120e+04 Min. : 5.90 Min. : 1.50 Min. :18.91 Min. : 6.464 Min. : 1.477 Min. :11.05 Min. :45.45 Min. : 0.6856 Min. :-10.9551 Min. :5.740e+03 Min. :2.586e+04 Min. :23.29 Min. :2.528e+04 Min. :44.37 Min. :0.000e+00 Min. :-235.7924 Min. : 0.00 Min. :-187.142 Min. :1.267e+03 Min. : 2.845 Min. : 0.474 Min. : 0.009 Min. : 0.292 Min. : 0.000 Min. : 0.000 Min. : 0.0074 Min. :-381.37
Class :character Class :character 1st Qu.: 17200 1st Qu.: 9.165 1st Qu.: 1.002e+08 1st Qu.:9.803e+08 1st Qu.:3.151e+08 1st Qu.:-1.296e+09 1st Qu.:-1.077e+08 1st Qu.: 2.704e+07 1st Qu.:5.762e+08 1st Qu.:2.022e+08 1st Qu.: 0.000e+00 1st Qu.: 3.095e+07 1st Qu.: 72.093 1st Qu.: 0.00 1st Qu.: 30.94 1st Qu.: 2.34 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.: 0.208 1st Qu.:0.000e+00 1st Qu.: 0.000 1st Qu.: 3.852 1st Qu.: 1.590 1st Qu.: 0 1st Qu.: 0.0000 1st Qu.:0.2443 1st Qu.: 1300 1st Qu.: 802 1st Qu.: 43.603 1st Qu.: 0.506 1st Qu.: 0 1st Qu.: 0.000 1st Qu.: 7530 1st Qu.: 160 1st Qu.: 1817 1st Qu.: 2.669 1st Qu.: 550.6 1st Qu.: 4.720 1st Qu.:22.43 1st Qu.:12.49 1st Qu.: 0.385 1st Qu.:16.84 1st Qu.: 23.438 1st Qu.: 610060 1st Qu.: 20.529 1st Qu.: 1078178 1st Qu.: 2.546e+09 1st Qu.: 26.11 1st Qu.: 2.338 1st Qu.: 0.14 1st Qu.:4.301e+09 1st Qu.: 97.72 1st Qu.:9.514e+08 1st Qu.: -0.3 1st Qu.:1.306e+09 1st Qu.: 24.52 1st Qu.: 45.548 1st Qu.: 7.914 1st Qu.:42.10 1st Qu.:2.366e+09 1st Qu.: 1.234 1st Qu.: 0.0000 1st Qu.: 734.0 1st Qu.: -0.3525 1st Qu.: 0.231 1st Qu.: 3.771e+08 1st Qu.: 11.01 1st Qu.: 6.971e+08 1st Qu.: 14.92 1st Qu.:-1.014e+09 1st Qu.:-1.152e+10 1st Qu.: 1.769e+08 1st Qu.: 4.764e+08 1st Qu.: 2.163e+09 1st Qu.:6.000 1st Qu.: 18.193 1st Qu.: 73632 1st Qu.: 676 1st Qu.: 7.025 1st Qu.: 1.240 1st Qu.:12.89 1st Qu.:19.73 1st Qu.:16.81 1st Qu.:14.23 1st Qu.:36.51 1st Qu.:1.115e+06 1st Qu.:15.02 1st Qu.: 12.70 1st Qu.:59.23 1st Qu.:60.525 1st Qu.:51.795 1st Qu.:23.37 1st Qu.:53.43 1st Qu.: 3.2323 1st Qu.: 0.6081 1st Qu.:7.799e+05 1st Qu.:9.367e+05 1st Qu.:49.62 1st Qu.:9.620e+05 1st Qu.:48.96 1st Qu.:2.759e+05 1st Qu.: -0.4648 1st Qu.:26.13 1st Qu.: 1.034 1st Qu.:3.439e+05 1st Qu.: 33.374 1st Qu.: 8.363 1st Qu.: 7.229 1st Qu.:28.007 1st Qu.: 6.514 1st Qu.: 0.534 1st Qu.: 56.7006 1st Qu.: 12.79
Mode :character Mode :character Median : 107160 Median : 14.986 Median : 6.455e+08 Median :5.210e+09 Median :1.329e+09 Median :-1.701e+08 Median : 0.000e+00 Median : 2.269e+08 Median :3.805e+09 Median :1.231e+09 Median : 0.000e+00 Median : 1.366e+08 Median : 99.573 Median : 0.50 Median : 64.68 Median : 18.74 Median : 3.241 Median : 0.000 Median : 15.376 Median :5.000e+06 Median : 0.037 Median :18.890 Median : 2.312 Median : 7 Median : 0.6308 Median :0.3818 Median : 9296 Median : 4173 Median : 70.345 Median : 2.096 Median : 92 Median : 2.236 Median : 33645 Median : 990 Median : 7927 Median : 5.738 Median : 3550.0 Median : 9.399 Median :34.44 Median :18.61 Median : 2.503 Median :25.87 Median : 68.891 Median : 1287166 Median : 30.936 Median : 1999004 Median : 4.899e+10 Median : 67.41 Median : 5.298 Median : 6.80 Median :2.115e+10 Median :102.99 Median :5.442e+09 Median : 4.8 Median :6.530e+09 Median : 35.29 Median : 67.681 Median :12.805 Median :51.39 Median :1.244e+10 Median : 3.642 Median : 0.0000 Median : 2515.6 Median : 2.0261 Median : 2.010 Median : 3.666e+09 Median : 20.72 Median : 4.393e+09 Median : 20.95 Median :-1.190e+08 Median :-4.527e+08 Median : 9.781e+08 Median : 7.882e+09 Median : 2.837e+10 Median :6.000 Median : 25.637 Median : 437764 Median : 5770 Median :24.390 Median : 2.840 Median :39.60 Median :38.06 Median :38.27 Median :20.39 Median :51.50 Median :3.548e+06 Median :24.04 Median : 31.40 Median :68.90 Median :77.021 Median :64.457 Median :34.23 Median :60.62 Median : 4.7279 Median : 1.5452 Median :5.256e+06 Median :3.264e+06 Median :50.34 Median :3.232e+06 Median :49.66 Median :2.267e+06 Median : 0.6618 Median :46.83 Median : 2.358 Median :2.373e+06 Median : 53.175 Median :12.544 Median :12.115 Median :40.716 Median : 15.743 Median : 3.480 Median : 73.0276 Median : 23.33
NA NA Mean : 2719581 Mean : 22.455 Mean : 3.749e+10 Mean :1.813e+11 Mean :4.890e+10 Mean :-4.647e+08 Mean :-1.817e+09 Mean : 3.419e+10 Mean :1.848e+11 Mean :4.979e+10 Mean : 7.930e+09 Mean : 1.972e+09 Mean : 81.600 Mean :16.94 Mean : 58.97 Mean : 32.02 Mean : 17.579 Mean : 4.927 Mean : 29.913 Mean :7.828e+09 Mean : 2.236 Mean :30.297 Mean : 2.329 Mean : 91224 Mean : 11.6703 Mean :0.5440 Mean : 530304 Mean : 182783 Mean : 67.147 Mean : 4.763 Mean : 219993 Mean : 15.448 Mean : 763288 Mean : 51560 Mean : 156238 Mean : 8.864 Mean : 58094.5 Mean :10.795 Mean :34.88 Mean :20.21 Mean : 4.863 Mean :29.23 Mean : 354.603 Mean : 2947763 Mean : 33.807 Mean : 9328817 Mean : 4.199e+13 Mean : 75.44 Mean : 26.320 Mean : 22.95 Mean :8.510e+11 Mean :104.58 Mean :2.126e+11 Mean : 142.3 Mean :2.082e+11 Mean : 42.62 Mean : 79.841 Mean :13.316 Mean :51.13 Mean :7.288e+11 Mean : 3.474 Mean : 0.2636 Mean : 9811.8 Mean : 1.7913 Mean : 6.486 Mean : 2.239e+11 Mean : 19.19 Mean : 7.262e+10 Mean : 21.11 Mean :-4.071e+08 Mean :-9.054e+11 Mean : 1.486e+10 Mean : 2.774e+12 Mean : 2.973e+12 Mean :6.154 Mean : 28.088 Mean : 12767600 Mean : 173075 Mean :29.433 Mean : 3.195 Mean :44.35 Mean :42.57 Mean :43.35 Mean :20.06 Mean :50.51 Mean :7.299e+07 Mean :26.40 Mean : 44.95 Mean :66.13 Mean :71.801 Mean :62.257 Mean :33.09 Mean :60.08 Mean : 6.8313 Mean : 1.6662 Mean :1.248e+08 Mean :6.770e+07 Mean :50.08 Mean :6.887e+07 Mean :49.92 Mean :6.957e+07 Mean : 0.4594 Mean :46.20 Mean : 2.646 Mean :5.576e+07 Mean : 53.805 Mean :14.034 Mean :13.625 Mean :41.452 Mean : 26.770 Mean : 16.105 Mean : 68.0533 Mean : 26.75
NA NA 3rd Qu.: 547566 3rd Qu.: 25.867 3rd Qu.: 5.462e+09 3rd Qu.:3.103e+10 3rd Qu.:8.885e+09 3rd Qu.:-3.929e+06 3rd Qu.: 2.950e+07 3rd Qu.: 2.442e+09 3rd Qu.:3.157e+10 3rd Qu.:8.472e+09 3rd Qu.: 9.700e+07 3rd Qu.: 4.751e+08 3rd Qu.:100.000 3rd Qu.:28.59 3rd Qu.: 91.11 3rd Qu.: 58.72 3rd Qu.: 23.129 3rd Qu.: 0.000 3rd Qu.: 55.624 3rd Qu.:5.790e+08 3rd Qu.: 1.473 3rd Qu.:51.876 3rd Qu.: 2.835 3rd Qu.: 9446 3rd Qu.: 17.0232 3rd Qu.:0.6505 3rd Qu.: 66838 3rd Qu.: 31005 3rd Qu.: 94.294 3rd Qu.: 6.263 3rd Qu.: 8870 3rd Qu.: 25.118 3rd Qu.: 121271 3rd Qu.: 6418 3rd Qu.: 31468 3rd Qu.: 9.933 3rd Qu.: 12887.5 3rd Qu.:15.000 3rd Qu.:47.14 3rd Qu.:25.96 3rd Qu.: 5.276 3rd Qu.:37.20 3rd Qu.: 160.677 3rd Qu.: 2996023 3rd Qu.: 43.035 3rd Qu.: 6761455 3rd Qu.: 6.330e+11 3rd Qu.: 100.00 3rd Qu.: 10.846 3rd Qu.: 41.06 3rd Qu.:1.363e+11 3rd Qu.:110.27 3rd Qu.:3.990e+10 3rd Qu.: 10.5 3rd Qu.:3.953e+10 3rd Qu.: 53.92 3rd Qu.: 99.047 3rd Qu.:17.665 3rd Qu.:59.64 3rd Qu.:9.368e+10 3rd Qu.: 5.997 3rd Qu.: 0.0909 3rd Qu.: 10076.1 3rd Qu.: 4.3111 3rd Qu.: 8.120 3rd Qu.: 3.573e+10 3rd Qu.: 27.93 3rd Qu.: 3.228e+10 3rd Qu.: 27.07 3rd Qu.: 0.000e+00 3rd Qu.: 0.000e+00 3rd Qu.: 6.071e+09 3rd Qu.: 1.007e+11 3rd Qu.: 2.456e+11 3rd Qu.:7.000 3rd Qu.: 35.323 3rd Qu.: 1888648 3rd Qu.: 42036 3rd Qu.:46.410 3rd Qu.: 4.560 3rd Qu.:76.19 3rd Qu.:63.22 3rd Qu.:66.77 3rd Qu.:25.63 3rd Qu.:65.82 3rd Qu.:1.219e+07 3rd Qu.:37.24 3rd Qu.: 66.80 3rd Qu.:73.94 3rd Qu.:84.559 3rd Qu.:73.931 3rd Qu.:43.20 3rd Qu.:66.11 3rd Qu.: 9.9052 3rd Qu.: 2.5797 3rd Qu.:1.945e+07 3rd Qu.:1.161e+07 3rd Qu.:51.04 3rd Qu.:1.155e+07 3rd Qu.:50.38 3rd Qu.:9.431e+06 3rd Qu.: 1.8421 3rd Qu.:66.63 3rd Qu.: 3.949 3rd Qu.:9.277e+06 3rd Qu.: 73.870 3rd Qu.:17.890 3rd Qu.:18.369 3rd Qu.:54.030 3rd Qu.: 41.402 3rd Qu.: 15.647 3rd Qu.: 84.2422 3rd Qu.: 36.79
NA NA Max. :129956634 Max. :304.276 Max. : 4.859e+12 Max. :1.901e+13 Max. :5.885e+12 Max. : 2.578e+11 Max. : 2.827e+11 Max. : 4.790e+12 Max. :1.926e+13 Max. :6.246e+12 Max. : 1.258e+12 Max. : 1.678e+11 Max. :100.000 Max. :99.80 Max. :100.00 Max. :100.00 Max. :100.000 Max. :87.986 Max. :100.000 Max. :1.645e+12 Max. :65.444 Max. :98.343 Max. :103.158 Max. :7056781 Max. :207.3675 Max. :5.3510 Max. :34041046 Max. :10482498 Max. :258.524 Max. :360.853 Max. :15291329 Max. :216.648 Max. :45873850 Max. :3187680 Max. :8174420 Max. :192.227 Max. :2986520.0 Max. :48.431 Max. :90.38 Max. :81.25 Max. :86.957 Max. :96.97 Max. :21388.600 Max. :37468302 Max. :100.000 Max. :409712858 Max. : 1.021e+16 Max. :20422.89 Max. :23773.132 Max. :100.00 Max. :8.715e+13 Max. :261.43 Max. :2.525e+13 Max. :844788.2 Max. :2.472e+13 Max. :427.58 Max. :860.800 Max. :50.037 Max. :96.20 Max. :8.761e+13 Max. :149.973 Max. :22.4135 Max. :190512.7 Max. :140.3670 Max. :87.507 Max. : 2.348e+13 Max. : 88.39 Max. : 6.257e+12 Max. : 100.67 Max. : 2.923e+11 Max. : 1.051e+14 Max. : 7.741e+11 Max. : 6.511e+14 Max. : 4.503e+14 Max. :8.000 Max. :100.236 Max. :601000000 Max. :12493789 Max. :92.370 Max. :17.880 Max. :99.38 Max. :98.93 Max. :98.96 Max. :59.58 Max. :89.94 Max. :3.468e+09 Max. :56.95 Max. :219.30 Max. :85.42 Max. :96.093 Max. :92.978 Max. :51.57 Max. :86.40 Max. :28.3973 Max. : 17.6334 Max. :7.753e+09 Max. :3.843e+09 Max. :55.63 Max. :3.907e+09 Max. :76.71 Max. :3.399e+09 Max. : 29.6283 Max. :97.16 Max. : 48.936 Max. :4.352e+09 Max. :100.000 Max. :62.416 Max. :94.057 Max. :98.467 Max. :354.553 Max. :359.256 Max. :100.0000 Max. : 100.00
NA NA NA’s :116 NA’s :4044 NA’s :3905 NA’s :3840 NA’s :3841 NA’s :4105 NA’s :4436 NA’s :3912 NA’s :3850 NA’s :3833 NA’s :4579 NA’s :3739 NA’s :5253 NA’s :4731 NA’s :4731 NA’s :4731 NA’s :4731 NA’s :4835 NA’s :5196 NA’s :4725 NA’s :4731 NA’s :4776 NA’s :4855 NA’s :2159 NA’s :2485 NA’s :3095 NA’s :1994 NA’s :2112 NA’s :2485 NA’s :1997 NA’s :2159 NA’s :2485 NA’s :1556 NA’s :1112 NA’s :1374 NA’s :3270 NA’s :1354 NA’s :4839 NA’s :4839 NA’s :4839 NA’s :4839 NA’s :4839 NA’s :139 NA’s :3060 NA’s :2726 NA’s :4590 NA’s :3622 NA’s :3577 NA’s :3398 NA’s :4786 NA’s :3396 NA’s :3714 NA’s :2950 NA’s :4428 NA’s :2949 NA’s :2956 NA’s :2957 NA’s :3956 NA’s :3821 NA’s :1856 NA’s :2111 NA’s :2653 NA’s :1859 NA’s :2114 NA’s :2009 NA’s :3351 NA’s :3305 NA’s :5122 NA’s :4902 NA’s :2991 NA’s :2952 NA’s :4116 NA’s :4072 NA’s :4856 NA’s :833 NA’s :4628 NA’s :3890 NA’s :2094 NA’s :5301 NA’s :5301 NA’s :5301 NA’s :5301 NA’s :5301 NA’s :5301 NA’s :5301 NA’s :4938 NA’s :815 NA’s :1818 NA’s :1022 NA’s :1108 NA’s :1108 NA’s :927 NA’s :927 NA’s :927 NA’s :35 NA’s :32 NA’s :950 NA’s :927 NA’s :950 NA’s :927 NA’s :83 NA’s :462 NA’s :60 NA’s :85 NA’s :83 NA’s :60 NA’s :4267 NA’s :4275 NA’s :3931 NA’s :4301 NA’s :4666 NA’s :2228 NA’s :4094


Podsumowanie zbioru wdi_names

kable(summary(wdi_names)) %>% kable_styling("striped")
Series Code Series Name
Length:214 Length:214
Class :character Class :character
Mode :character Mode :character

Zbiór gold_prices (Gold Prices)

Czyszczenie zbioru danych gold_prices obejmowało:

  1. Utworzenie nowej kolumny USD, która była średnią arytmetyczną kolumny USD..AM. oraz USD..PM., czyli cen zbieranych w godzinach porannych i popołudniowych.
  2. Wybranie tylko kolumny Date i USD.
  3. Zmiana formatu daty yyyy-mm-dd na wartość numeryczną timestamp.
gold_prices_reshaped <- gold_prices %>%
  mutate(USD = (USD..AM. + USD..PM.) / 2) %>%
  select(Date, USD) %>%
  mutate(Date = as.numeric(as.POSIXct(Date, format = "%Y-%m-%d")))


Podsumowanie zbioru gold_prices_reshaped

kable(summary(gold_prices_reshaped)) %>% kable_styling("striped")
Date USD
Min. : -63075600 Min. : 34.76
1st Qu.: 360972000 1st Qu.: 281.60
Median : 784767600 Median : 383.50
Mean : 784953601 Mean : 576.75
3rd Qu.:1208901600 3rd Qu.: 853.25
Max. :1632866400 Max. :2058.15
NA NA’s :144

Zbiór sp_reshaped (S&P Composite)

Czyszczenie danych S&P Composite obejmowało

  1. Zmiana formatu daty yyyy-mm-dd na wartość numeryczną.
  2. Zmiana nazwy kolumny z Year na Date.
  3. Konwersja wszystkich kolumn na wartości numeryczne.
  4. Usunięcie wierszy z wartościami NA.
sp_reshaped <- sp_composite %>%
  mutate(Year = as.numeric(as.POSIXct(Year, format = "%Y-%m-%d"))) %>%
  rename(Date = Year) %>%
  mutate_all(function(x) as.numeric(x)) %>%
  drop_na()


Podsumowanie zbioru sp_reshaped:

kable(summary(sp_reshaped)) %>%
  kable_styling("striped") %>%
  scroll_box(width = "100%")
Date S.P.Composite Dividend Earnings CPI Long.Interest.Rate Real.Price Real.Dividend Real.Earnings Cyclically.Adjusted.PE.Ratio
Min. :-2.806e+09 Min. : 3.810 Min. : 0.180 Min. : 0.160 Min. : 6.28 Min. : 0.620 Min. : 95.75 Min. : 6.792 Min. : 4.576 Min. : 4.784
1st Qu.:-1.698e+09 1st Qu.: 8.642 1st Qu.: 0.470 1st Qu.: 0.670 1st Qu.: 10.56 1st Qu.: 3.122 1st Qu.: 197.59 1st Qu.: 9.959 1st Qu.: 15.776 1st Qu.:11.890
Median :-5.906e+08 Median : 23.780 Median : 1.412 Median : 2.417 Median : 25.80 Median : 3.710 Median : 309.11 Median :15.222 Median : 26.696 Median :16.372
Mean :-5.905e+08 Mean : 341.689 Mean : 7.192 Mean : 16.438 Mean : 65.57 Mean : 4.493 Mean : 649.80 Mean :18.270 Mean : 36.700 Mean :17.168
3rd Qu.: 5.172e+08 3rd Qu.: 237.850 3rd Qu.: 8.067 3rd Qu.: 15.182 3rd Qu.:109.45 3rd Qu.: 5.023 3rd Qu.: 734.41 3rd Qu.:23.398 3rd Qu.: 44.724 3rd Qu.:20.898
Max. : 1.625e+09 Max. :4238.490 Max. :59.680 Max. :158.740 Max. :271.70 Max. :15.320 Max. :4258.88 Max. :63.511 Max. :159.504 Max. :44.198

Zbiór bitcoin_all (dane dotyczące obrotu bitcoinem)

Dane dotyczące bitcoina (bitcoin_mkpru, bitcoin_hrate, bitcoin_diff, bitcoin_trvou) zostały połączone w jeden zbiór danych za pomocą operacji inner_join. Ten sposób połączenia pozwolił na wyeliminowanie części wartości pustych.

Łączenie i czyszczenie obejmowało:

  1. Połączenie zbiorów danych bitcoin_mkpru, bitcoin_hrate, bitcoin_diff, bitcoin_trvou za pomocą operacji inner_join.
  2. Zmiana nazw kolumn na odpowiadające wskaźnikom.
  3. Zmiana formatu daty z yyyy-mm-dd na wartość numeryczną timestamp.
  4. Konwersja kolumn ze wskaźnikami na wartości numeryczne.
bitcoin_all <- inner_join(bitcoin_mkpru, bitcoin_diff, by = "Date") %>%
  inner_join(bitcoin_hrate, by = "Date") %>%
  inner_join(bitcoin_trvou, by = "Date") %>%
  rename("mkpru" = `Value.x`, "diff" = `Value.y`, "hrate" = `Value.x.x`, "trvou" = `Value.y.y`) %>%
  mutate(Date = as.numeric(as.POSIXct(Date, format = "%Y-%m-%d"))) %>%
  mutate_at(2:5, function(x) as.numeric(x))


Podsumowanie zbioru bitcoin_all

kable(summary(bitcoin_all)) %>% kable_styling("striped")
Date mkpru diff hrate trvou
Min. :1.231e+09 Min. : 0.00 Min. :0.000e+00 Min. : 0 Min. :0.000e+00
1st Qu.:1.332e+09 1st Qu.: 7.21 1st Qu.:1.689e+06 1st Qu.: 12 1st Qu.:1.948e+05
Median :1.432e+09 Median : 431.89 Median :4.881e+10 Median : 356089 Median :6.824e+06
Mean :1.432e+09 Mean : 5132.38 Mean :3.665e+12 Mean : 26458258 Mean :1.467e+08
3rd Qu.:1.533e+09 3rd Qu.: 6496.35 3rd Qu.:5.364e+12 3rd Qu.: 38265984 3rd Qu.:1.484e+08
Max. :1.633e+09 Max. :63554.44 Max. :2.505e+13 Max. :198514006 Max. :5.352e+09

Sprawdzenie korelacji między wskaźnikami gospodarczymi

Do sprawdzenia korelacji zostały wykorzystane jedynie kolumny numeryczne. Macierz korelacji została stworzona z wykorzystaniem funkcji cor z parametrem pairwise.complete.obs, który pomijał w obliczeniach pary, które zawierały wartości NA. Komórki znajdujące się na głównej przekątnej macierzy oraz ponad nią zostały usunięte. Następnie macierz została przetransformowana do tabeli, w której w wierszu znajdowały się wskaźniki gospodarcze oraz wartość korelacji pomiędzy nimi. Wybrane zostały korelacje z przedziału (0.75, 0.9), ponieważ wartości powyżej 0.9 wskazywały oczywiste związki między zmiennymi np. wzrost liczby ludności i wzrost liczby kobiet/mężczyzn w kraju.

wdi_cor_matrix <- wdi_reshaped %>%
  select(3:115) %>%
  cor(use = "pairwise.complete.obs")
wdi_cor_matrix[!lower.tri(wdi_cor_matrix)] <- NA

wdi_cor <- wdi_cor_matrix %>%
  data.frame() %>%
  rownames_to_column(var = "A") %>%
  gather(key = "B", value = "Correlation", -A) %>%
  filter(abs(Correlation) < 0.9 & abs(Correlation) > 0.75)

Do tabeli korelacji zostały dołączone opisy poszczególnych wskaźników w celu łatwiejszej interpretacji.

wdi_cor_names <- inner_join(wdi_cor, wdi_names, by = c("A" = "Series Code")) %>%
  inner_join(wdi_names, by = c("B" = "Series Code")) %>%
  mutate(A = `Series Name.x`, B = `Series Name.y`) %>%
  select(-c(`Series Name.x`, `Series Name.y`))

Tabela korelacji wskaźników gospodarczych

prettyTable <- function(table_df, round_digits=2) {
    DT::datatable(table_df, style="bootstrap", filter = "top", rownames = FALSE, extensions = "Buttons", options = list(dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))) %>% formatRound(names(dplyr::select_if(table_df, is.numeric)), round_digits)
}

prettyTable(wdi_cor_names)

Wykres macierzy korelacji wskaźników gospodarczych

p <- ggcorrplot(wdi_cor_matrix) +
  labs(x = "Wskaźnik 1", y = "Wskaźnik 2") +
  theme_classic() +
  theme(axis.text = element_blank(), axis.ticks = element_blank())

ggplotly(p)

Emisja CO2

Z powyższych wyliczeń wynika, że emisja CO2 jest silnie skorelowana z importem oraz eksportem dóbr. Zależność jest widoczna między kolumnami: CO2 emissions from liquid fuel consumption (kt), CO2 emissions from gaseous fuel consumption (kt), a kolumnami: Goods exports (BoP, current US$), Goods imports (BoP, current US$). Współczynnik korelacji między kolumnami znajduje się w przedziale <0.80, 0.87> i zależność ta wskazuje na silną potrzebę rozwoju silników elektrycznych, które są mniej destrukcyjne dla środowiska.

Import/eksport dóbr a emisja CO2 przez spalanie paliwa w stanie ciekłym/gazowym w USA

co2_import_export <- wdi_reshaped %>%
  select(c(`Year`, `Country Name`, `EN.ATM.CO2E.LF.KT`, `EN.ATM.CO2E.GF.KT`, `BM.GSR.MRCH.CD`, `BX.GSR.MRCH.CD`)) %>%
  filter(`Country Name` == "United States")

co2_import_plot <- ggplot(co2_import_export, aes(x = Year, y = `BM.GSR.MRCH.CD`)) +
  geom_point() +
  theme(axis.text = element_blank(), axis.ticks = element_blank()) +
  labs(x = "Rok", y = "Import dóbr")

co2_export_plot <- ggplot(co2_import_export, aes(x = Year, y = `BX.GSR.MRCH.CD`)) +
  geom_point() +
  theme(axis.text = element_blank(), axis.ticks = element_blank()) +
  labs(x = "Rok", y = "Eksport dóbr")

co2_liq_plot <- ggplot(co2_import_export, aes(x = Year, y = `EN.ATM.CO2E.LF.KT`)) +
  geom_point() +
  theme(axis.text = element_blank(), axis.ticks = element_blank()) +
  labs(x = "Rok", y = "CO2 (paliwo w stanie ciekłym)")

co2_gas_plot <- ggplot(co2_import_export, aes(x = Year, y = `EN.ATM.CO2E.GF.KT`)) +
  geom_point() +
  theme(axis.text = element_blank(), axis.ticks = element_blank()) +
  labs(x = "Rok", y = "CO2 (paliwo w stanie gazowym)")

grid.arrange(co2_import_plot, co2_export_plot, co2_liq_plot, co2_gas_plot, ncol = 4)

Analiza wybranych wskaźników gospodarczych

Zmiana populacji kobiet i mężczyzn w Chinach, Indiach i USA.

population_comparison <- wdi_reshaped %>%
  select(Year, `Country Name`, `SP.POP.TOTL.MA.IN`, `SP.POP.TOTL.FE.IN`) %>%
  filter(`Country Name` %in% c("China", "United States", "India")) %>%
  mutate(Year = as.numeric(Year))

plot <- population_comparison %>%
  mutate(`SP.POP.TOTL.MA.IN` = `SP.POP.TOTL.MA.IN` / 1000000000, `SP.POP.TOTL.FE.IN` = `SP.POP.TOTL.FE.IN` / 1000000000) %>%
  ggplot(aes(x = Year)) +
  geom_line(aes(y = `SP.POP.TOTL.MA.IN`, color = "Mezczyzni")) +
  geom_line(aes(y = `SP.POP.TOTL.FE.IN`, color = "Kobiety")) +
  facet_grid(. ~ `Country Name`) +
  labs(x = "Rok", y = "Populacja [mld]", color = "Plec")

plot.animation <- plot +
  transition_reveal(Year)
animate(plot.animation, renderer = gifski_renderer())

Wykres wskazuje znaczny wzrost populacji kobiet i meżczyzn zarówno w Chinach jak i Indiach, przy stopniowym wzroście w USA. Na zmniejszenie dynamiki wzrostu liczby ludności w Chinach ma wpływ prawdopodobnie polityka jednego dziecka obowiązująca w latach 1977-2015. Z tego również względu wynikać może spora różnica między populacją kobiet i mężczyzn, ponieważ rodziny mogły mieć jedno dziecko (większa liczba powodowała problemy ekonomiczne narzucone przez państwo) i bardziej preferowany był syn niż córka, co jest częstym zjawiskiem w krajach azjatyckich np. Indie. W krajach zachodnich różnica między populacją kobiet i mężczyzn jest niska tak jak wskazuje powyższy wykres dla kraju USA.

Korelacja w zbiorze bitcoin_all, gold_prices_reshaped i sp_reshaped

Do stworzenia regresora potrzebne były informacje, które pozwolą na jak najlepszą predykcję ceny bitcoina, dlatego sprawdzona została korelacja między kolumnami w zbiorach bitcoin_all, gold_prices_reshaped i sp_reshaped. Najpierw, dane dotyczące bitcoina zostały połączone ze zbiorem z cenami złota po kolumnie Date z wykorzystaniem funkcji inner_join, aby zmniejszyć występowanie wartości pustych. Następnie do wynikowego zbioru został dołączony zbiór sp_reshaped z wykorzystaniem operacji left_join. Różnica w sposobie połączenia wynikała z tego, że dane dotyczące bitcoina oraz cen złota były zbierane codziennie, natomiast informacje zawarte w zbiorze sp_reshaped dotyczyły każdego miesiąca. Taki sposób połączenia pozwolił na wypełnienie wartości pustych występujących w każdym dniu danego miesiąca przez wykorzystanie funkcji fill z parametrem downup.

bitcoin_gold_sp <- inner_join(bitcoin_all, gold_prices_reshaped, by = "Date") %>%
  left_join(sp_reshaped, by = "Date") %>%
  mutate_all(function(x) as.numeric(x)) %>%
  fill(7:15, .direction = "downup")

bitcoin_gold_sp_cor_matrix <- bitcoin_gold_sp %>%
  select(2:15) %>%
  cor(use = "pairwise.complete.obs")

bitcoin_gold_sp_cor_matrix[!lower.tri(bitcoin_gold_sp_cor_matrix)] <- NA

Wykres macierzy korelacji zbioru bitcoin_gold_sp

p <- ggcorrplot(bitcoin_gold_sp_cor_matrix) +
  theme_classic() +
  theme(axis.title = element_blank(), axis.ticks = element_blank(), axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))

ggplotly(p)

Tabela korelacji zbioru bitcoin_gold_sp

Zostały wybrane te kolumny, które z kolumną mkpru (ceną bitcoina) najbardziej korelują (współczynnik korelacji większy od 0.5) i posłużą do stworzenia regresora przewidującego cenę bitcoina.

bitcoin_gold_sp_cor <- bitcoin_gold_sp_cor_matrix %>%
  data.frame() %>%
  rownames_to_column(var = "A") %>%
  gather(key = "B", value = "Correlation", -A) %>%
  filter((A == "mkpru" | B == "mkpru") & abs(Correlation) > 0.5)

prettyTable(bitcoin_gold_sp_cor)

bitcoin_reg <- bitcoin_gold_sp %>%
  select(c(Date, mkpru, diff, hrate, trvou, `S.P.Composite`, Dividend, CPI, `Real.Price`, `Real.Dividend`, `Cyclically.Adjusted.PE.Ratio`))

Regresor przewidujący cenę bitcoina

Zbiór bitcoin_reg zawierający wszystkie statystyki dotyczące bitcoina, cen złota oraz S&P Composite został podzielony na zbiór uczący oraz testowy w sposób losowy w stosunku 1:3. Zbiór walidujący został stworzony wykorzystując powtarzaną ocenę krzyżową z liczbą podziałów 2 i liczbą powtórzeń 5.

bitcoin_in_training <- createDataPartition(y = bitcoin_reg$mkpru, p = 0.75, list = FALSE)
bitcoin_training <- bitcoin_reg[bitcoin_in_training,] %>% as.data.frame()
bitcoin_testing <- bitcoin_reg[-bitcoin_in_training,] %>% as.data.frame()
bitcoin_ctrl <- trainControl(method = "repeatedcv", number = 2, repeats = 5)

Poniższy wykres przedstawia podobieństwo rozkładów danych uczących i testowych.

ggplot() +
  geom_density(aes(mkpru, fill = "Uczący"), bitcoin_training, alpha = 0.6) +
  geom_density(aes(mkpru, fill = "Testowy"), bitcoin_testing, alpha = 0.6) +
  labs(x = "mkpru", y = "Gęstość", fill = "Zbiór")

Algorytm Lasso

Pierwszy model został stworzony z wykorzystaniem algorytmu lasso.

bitcoin_fit_lasso <- train(mkpru ~ ., data = bitcoin_training, method = "lasso")


Ważność atrybutów dla znalezionego modelu

ggplot(varImp(bitcoin_fit_lasso)) +
  labs(x = "Ważność", y = "Cecha")

Predykcja modelu

bitcoin_lasso_predicted <- predict(bitcoin_fit_lasso, bitcoin_testing) %>%
  as.data.frame()

Do oceny predykcji wykorzystane zostały dwie miary: R2 oraz RMSE.

lasso_rmse <- RMSE(unlist(bitcoin_lasso_predicted), bitcoin_testing$mkpru)
lasso_r2 <- R2(unlist(bitcoin_lasso_predicted), bitcoin_testing$mkpru)
print(paste("RMSE: ", lasso_rmse))
print(paste("R2: ", lasso_r2))
## [1] "RMSE:  2962.21485075706"
## [1] "R2:  0.92053793575698"

Poniższy wykres przedstawia wartości zbioru testowego i wartości wynikowe modelu

bitcoin_predicted_lasso_compare <- data.frame(date = bitcoin_testing$Date, actual = bitcoin_testing$mkpru, predicted = bitcoin_lasso_predicted$.)

ggplot(bitcoin_predicted_lasso_compare, aes(x = date)) +
  geom_line(aes(y = actual, color = "Testowe")) +
  geom_line(aes(y = predicted, color = "Lasso")) +
  labs(color = "Wartości", x = "Data", y = "mkpru") +
  theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())

Algorytm Ridge

Kolejny model został stworzony z wykorzystaniem algorytmu ridge.

bitcoin_fit_ridge <- train(mkpru ~ ., data = bitcoin_training, method = "ridge")


Ważność atrybutów dla znalezionego modelu

ggplot(varImp(bitcoin_fit_ridge)) +
  labs(x = "Ważność", y = "Cecha")

Predykcja modelu

bitcoin_ridge_predicted <- predict(bitcoin_fit_ridge, bitcoin_testing) %>%
  as.data.frame()

Do oceny predykcji wykorzystane zostały dwie miary: R2 oraz RMSE.

ridge_rmse <- RMSE(unlist(bitcoin_ridge_predicted), bitcoin_testing$mkpru)
ridge_r2 <- R2(unlist(bitcoin_ridge_predicted), bitcoin_testing$mkpru)
print(paste("RMSE: ", ridge_rmse))
print(paste("R2: ", ridge_r2))
## [1] "RMSE:  2970.46587524583"
## [1] "R2:  0.920568177822367"

Poniższy wykres przedstawia wartości zbioru testowego i wartości wynikowe modelu

bitcoin_predicted_ridge_compare <- data.frame(date = bitcoin_testing$Date, actual = bitcoin_testing$mkpru, predicted = bitcoin_ridge_predicted$.)

ggplot(bitcoin_predicted_ridge_compare, aes(x = date)) +
  geom_line(aes(y = actual, color = "Testowe")) +
  geom_line(aes(y = predicted, color = "Ridge")) +
  labs(color = "Wartości", x = "Data", y = "mkpru") +
  theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())

Porównanie modeli

model_list <- list(lasso = bitcoin_fit_lasso, ridge = bitcoin_fit_ridge)
res <- resamples(model_list)
summary(res)
bitcoin_predicted_compare <- data.frame(date = bitcoin_testing$Date, actual = bitcoin_testing$mkpru, predicted_lasso = bitcoin_lasso_predicted$., predicted_ridge = bitcoin_ridge_predicted$.)

ggplot(bitcoin_predicted_compare, aes(x = date)) +
  geom_line(aes(y = actual, color = "Testowe")) +
  geom_line(aes(y = predicted_lasso, color = "Lasso")) +
  geom_line(aes(y = predicted_ridge, color = "Ridge")) +
  labs(color = "Wartości", x = "Data", y = "mkpru") +
  theme(axis.ticks.x = element_blank(), axis.text.x = element_blank())